home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / wsc4d21.zip / SELF_PGM.PAS < prev    next >
Pascal/Delphi Source File  |  1997-06-05  |  6KB  |  219 lines
  1. unit Self_pgm;
  2.  
  3. interface
  4.  
  5. uses
  6.   DisplayUnit,
  7.   SysUtils, WinTypes, WinProcs, Messages,
  8.   Classes, Graphics, Controls,
  9.   Forms, Dialogs, Menus,
  10.   wsc, ExtCtrls, StdCtrls;
  11. type
  12.   TSelf = class(TForm)
  13.     MainMenu: TMainMenu;
  14.     menuPort: TMenuItem;
  15.     Test: TMenuItem;
  16.     menuCOM1: TMenuItem;
  17.     menuCOM2: TMenuItem;
  18.     menuCOM3: TMenuItem;
  19.     menuCOM4: TMenuItem;
  20.     Instructions: TMenuItem;
  21.     menuExit: TMenuItem;
  22.     Memo: TMemo;
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure menuCOM1Click(Sender: TObject);
  25.     procedure menuCOM2Click(Sender: TObject);
  26.     procedure menuCOM3Click(Sender: TObject);
  27.     procedure menuCOM4Click(Sender: TObject);
  28.     procedure KeyPress(Sender: TObject; var Key: Char);
  29.     procedure InstructionsClick(Sender: TObject);
  30.     procedure TestClick(Sender: TObject);
  31.     procedure menuExitClick(Sender: TObject);
  32.   
  33.   private
  34.     { Private declarations }
  35.     Port : Integer;
  36.     Baud : Integer;
  37.     Parity : Integer;
  38.     DataBits : Integer;
  39.     StopBits : Integer;
  40.     TestText : string;
  41.   public
  42.     { Public declarations }
  43.   end ;
  44.  
  45. var
  46.   Self: TSelf;
  47.  
  48. implementation
  49.  
  50. {$R *.DFM}
  51.  
  52. procedure TSelf.FormCreate(Sender: TObject);
  53. var
  54.   I    : Integer;
  55.   Code : Integer;
  56. begin
  57.   (* initialize parameters *)
  58.   Port := COM1;
  59.   Baud := Baud19200;
  60.   Parity := NoParity;
  61.   DataBits := WordLength8;
  62.   StopBits := OneStopBit;
  63.   Self.Caption := 'Selftest: COM' + Chr($31+Port);
  64.   menuCOM1.Checked := true;
  65.   TestText := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  66. end;
  67.  
  68. procedure TSelf.menuCOM1Click(Sender: TObject);
  69. begin
  70.   Self.Caption := 'Selftest: COM' + Chr($31+Port);
  71.   menuCOM1.Checked := true;
  72.   menuCOM2.Checked := false;
  73.   menuCOM3.Checked := false;
  74.   menuCOM4.Checked := false;
  75.   Port := COM1
  76. end;
  77.  
  78. procedure TSelf.menuCOM2Click(Sender: TObject);
  79. begin
  80.   Self.Caption := 'Selftest: COM' + Chr($32+Port);
  81.   menuCOM1.Checked := false;
  82.   menuCOM2.Checked := true;
  83.   menuCOM3.Checked := false;
  84.   menuCOM4.Checked := false;
  85.   Port := COM2
  86. end;
  87.  
  88. procedure TSelf.menuCOM3Click(Sender: TObject);
  89. begin
  90.   Self.Caption := 'Selftest: COM' + Chr($33+Port);
  91.   menuCOM1.Checked := false;
  92.   menuCOM2.Checked := false;
  93.   menuCOM3.Checked := true;
  94.   menuCOM4.Checked := false;
  95.   Port := COM3
  96. end;
  97.  
  98. procedure TSelf.menuCOM4Click(Sender: TObject);
  99. begin
  100.   Self.Caption := 'Selftest: COM' + Chr($34+Port);
  101.   menuCOM1.Checked := false;
  102.   menuCOM2.Checked := false;
  103.   menuCOM3.Checked := false;
  104.   menuCOM4.Checked := true;
  105.   Port := COM4
  106. end;
  107.  
  108.  
  109. procedure TSelf.KeyPress(Sender: TObject; var Key: Char);
  110. var
  111.   Code : Integer;
  112. begin
  113.   Code := SioPutc(Port,Key);
  114. end;
  115.  
  116. procedure TSelf.InstructionsClick(Sender: TObject);
  117. begin
  118.    DisplayLine(Memo,'SELFTEST tests a single port for functionality.');
  119.    DisplayLine(Memo,'The port must terminate with a loopback adapter.');
  120.    DisplayLine(Memo,'See LOOPBACK.DOC for more information.')
  121. end;
  122.  
  123. procedure TSelf.TestClick(Sender: TObject);
  124. var
  125.   Code : Integer;
  126.   I, N : Integer;
  127.   Loop : Integer;
  128.   Size : Integer;
  129.   Ch   : Char;
  130.   Hr,Mn,ms : Word;
  131.   Sec1,Sec2: Word;
  132.   MaxRxQue : Integer;
  133.   MaxTxQue : Integer;
  134. begin
  135.   (* initialize WSC *)
  136.   Code := SioReset(Port,1024,1024);
  137.   if Code < 0 then begin
  138.     DisplayString(Memo,Format('Error %d: ',[Code]));
  139.     DisplayError(Memo, Code);
  140.     exit
  141.   end;
  142.   (* update settings *)
  143.   Code := SioBaud(Port,Baud);
  144.   Code := SioParms(Port, Parity, StopBits, DataBits);
  145.   Code := SioDTR(Port,'S');
  146.   Code := SioRTS(Port,'S');
  147.   Code := SioFlow(Port,'N');
  148.   (* display the test string *)
  149.   Size := Length(TestText);
  150.   DisplayString(Memo,'Test string "');
  151.   DisplayString(Memo,TestText);
  152.   DisplayLine(Memo,'"');
  153.   (* send TestText 16 times *)
  154.   DisplayString(Memo,'  Sending: ');
  155.   for Loop := 1 to 16 do
  156.     begin
  157.       DisplayString(Memo,Format('%d ',[Loop]));
  158.       (* send test string *)
  159.       for I := 1 to Size do Code := SioPutc(Port,TestText[i]);
  160.     end;
  161.   MaxRxQue := SioRxQue(Port);
  162.   MaxTxQue := SioTxQue(Port);
  163.   DisplayLine(Memo,' ');
  164.   (* receive echo *)
  165.   DisplayString(Memo,'Receiving: ');
  166.   for Loop := 1 to 16 do
  167.     begin
  168.       DisplayString(Memo,Format('%d ',[Loop]));
  169.       (* get response *)
  170.       for N := 1 to Size do
  171.         begin
  172.           (* expect character Ch *)
  173.           Ch := TestText[N];
  174.           DecodeTime(Time,Hr,Mn,Sec1,ms);
  175.           (* get next incoming character *)
  176.           repeat
  177.             (* fetch serial character *)
  178.             Code := SioGetc(Port);
  179.             if Code >= 0 then
  180.               begin
  181.                 (* is it the character expected? *)
  182.                 if Ch <> char(code) then
  183.                   begin
  184.                     DisplayLine(Memo,Format('Expected %c not %c',[Ch,chr(Code)]));
  185.                     Code := SioDone(Port);
  186.                     exit
  187.                   end
  188.               end
  189.             (* no incoming character *)
  190.             else DecodeTime(Time,Hr,Mn,Sec2,ms);
  191.           until (Code>0) or (Sec2 = (Sec1 + 2) mod 60);
  192.           (* did we time out? *)
  193.           if Code < 0 then
  194.             begin
  195.               DisplayLine(Memo,'Timed out waiting for serial input');
  196.               Code := SioDone(Port);
  197.               exit
  198.             end
  199.         end
  200.     end;
  201.   DisplayLine(Memo,' ');
  202.   DisplayLine(Memo,Format('RX queue size = %d',[MaxRxQue]));
  203.   DisplayLine(Memo,Format('TX queue size = %d',[MaxTxQue]));
  204.   SioRxClear(Port);
  205.   (* close down *)
  206.   DisplayLine(Memo,'Shutting down COM port');
  207.   Code := SioDone(Port)
  208. end;
  209.  
  210. procedure TSelf.menuExitClick(Sender: TObject);
  211. var
  212.   Code : Integer;
  213. begin
  214.   Code := SioDone(Port);
  215.   Application.Terminate;
  216. end;
  217.  
  218. end.
  219.